2022 IR Marine DO analysis
Oregon’s marine dissolved oxygen standard states:
- For ocean waters, no measurable reduction in dissolved oxygen concentration may be
allowed.
Currently, no marine DO assessment methodology exists. DEQ is in the process of planning and assembling a technical work group to help develop assessment methodology for marine OAH issues.
There are two data sets that the assessment team analyzed. 1. Continuous DO data collected at marine mooring stations (OOI data) and 2. Discrete DO samples collected on cruises along the Newport line. The following in a summary of the analysis performed on the data.
OOI data
Download continuous DO data from AWQMS:
ooi_DO_data <- AWQMS_Data_Cont(org = "OOI_(NOSTORETID)",
char = "Dissolved oxygen (DO)")This data represents one station at CE01ISSM for date range 2018-04-03 - 2020-12-31.
The first step the assessment team took was to visualize the data. Chan et. al. 2019 defines some conditions for marine DO.
| Status | Value | units |
|---|---|---|
| Hypoxic | 1.99864 | mg/l |
| Severe Hypoxia | 0.71380 | mg/l |
| Suboxic | 0.14276 | mg/l |
| Anoxic | 0.00000 | mg/l |
ooi_DO_data_graph <- ooi_DO_data %>%
mutate(result_conv = Result_Numeric* (1.4/63.9)*1.42905,
result_unit = 'ml/l',
date = ymd(Result_Date),
month = month(date),
yrmon = as.yearmon(date),
year = year(date))
q <-
ggplot(data = ooi_DO_data_graph) +
geom_point(aes(x = date, y = result_conv, color = Depth)) +
labs(title = "Dissolved Oxygen",
subtitle = paste0(ooi_DO_data_graph$MLocID[1], ": ", ooi_DO_data_graph$StationDes[1]),
caption = paste0("Lat/Long: ",
ooi_DO_data_graph$Lat_DD[1], ", ",ooi_DO_data_graph$Long_DD[1] ),
x = element_blank(),
y = "mg/L")+
theme_bw()+
geom_line(data = water_status,
aes(x = Date, y = Value, linetype = Status)) +
scale_color_brewer(palette="Paired")
q
There appears to be some seasonality to the DO pattern, with regular drops into Severe Hypoxia conditions and occasional drops into Suboxic conditions.
Next, we wanted to see if there was any trend that could be seen in the data. Since there is some obvious seasonality to the data set, the assessment team ran a Seasonal Mann Kendall test on the monthly average DO concentration, using months as the seasonal component. To ensure data completeness we only included months with less than 3 missing days in the data set.
month_average <- ooi_DO_data %>%
mutate(result_conv = Result_Numeric* (1.4/63.9)*1.42905, #convert to mg/L
result_unit = 'mg/l',
date = ymd(Result_Date),
month = month(date),
yrmon = as.yearmon(date),
year = year(date),
loc_depth = paste0(MLocID, "-", Depth,Depth_Unit )) %>%
group_by(MLocID,loc_depth, year, month, Depth) %>%
summarise(mon_avg = mean(result_conv),
num_days = n_distinct(date),
count = n()) %>%
ungroup() %>%
complete(loc_depth, year, month)
months_exclude <- month_average %>%
mutate(mo_days = days_in_month(month),
diff = mo_days - num_days,
exclude = ifelse(diff > 3 | is.na(mon_avg), "yes", "no")) %>%
select(MLocID, loc_depth, year, month, exclude)
month_average_assess <- month_average %>%
left_join(months_exclude, by = c("loc_depth", "year", "month", "MLocID"))%>%
filter(exclude == "no") %>%
select(MLocID, loc_depth, Depth, year, month, mon_avg) %>%
mutate(date = paste0(year, "-", month, "-01")) %>%
mutate(date = ymd(date)) %>%
mutate(variable = as.factor("DO")) %>%
select(date, MLocID,loc_depth, Depth, variable, mon_avg) %>%
rename(value = mon_avg,
site = MLocID)
#Loop through different depths
#create empty list to accept test results
kendall_list <- list()
for(i in 1:length(unique(month_average_assess$loc_depth))){
#select unique site ID and arrange in chronological order
#fill in NAs for missing months
mo_avg_seamannkenn <- month_average_assess %>%
filter(loc_depth == unique(month_average_assess$loc_depth)[i]) %>%
mutate(Depth = as.numeric(Depth))
#create wqdata format table
wqdataframe <- wqData(mo_avg_seamannkenn, c(1, 2, 4), 5:6, site.order = TRUE, type = "long",
time.format = "%y-%m-%d")
#create time series
timeseries <- tsMake(wqdataframe, focus= wqdataframe$site[1])
res <- seaKen(timeseries)
#save results as a dataframe and add MLocID and n
df <- data.frame(as.list(unclass(res))) %>%
mutate(loc_depth = unique(month_average_assess$loc_depth)[i],
n = length(timeseries))
#bind results list
kendall_list[[i]] <- df
} #end of for loop
#bind results of seasonal mann kendall test to single dataframe
kendall_results <- bind_rows(kendall_list)
#trend is detected when the tau > critical value and p. value (sl) is <0.10
#reorder and rename rows for better exporting
kendall_results <- kendall_results %>%
mutate(significance = ifelse(p.value < 0.10 & sen.slope < 0, "Signifigant (-)",
ifelse(p.value < 0.10 & sen.slope > 0, "Signifigant (+)",
"No Trend"))) %>%
select(loc_depth, significance, p.value, sen.slope)
kendall_results %>%
kbl() %>%
kable_classic(full_width = F, html_font = "Cambria")| loc_depth | significance | p.value | sen.slope |
|---|---|---|---|
| CE01ISSM-25.00m | No Trend | 0.6674365 | -0.0210354 |
| CE01ISSM-7.00m | No Trend | 0.5790997 | 0.1116678 |
In this data set, there is no significant trend detected. However, this is a limited data set, with only a few years covered. This data represents what was submitted to us. In future assessments, if we have a longer data set, it is possible that a trend may emerge. To visualize the data:
station <- ooi_DO_data %>%
select(OrganizationID, MLocID, StationDes,Lat_DD, Long_DD, AU_ID ) %>%
distinct()
#point graph
mon_avg_graph <- month_average %>%
mutate(yearmon = as.Date(paste0(year,"-",month,"-1"))) %>%
mutate(moname = month.name[month]) %>%
filter(!is.na(mon_avg)) %>%
left_join(station, by = "MLocID")
#join trend analysis to data
mon_avg_graph_trend <- mon_avg_graph %>%
left_join(kendall_results, by = "loc_depth") %>%
left_join(months_exclude, by = c("loc_depth", "year", "month", "MLocID")) %>%
filter(exclude == "no") %>%
select(-exclude)
p <- ggplot(data = mon_avg_graph_trend)+
geom_point(aes(x = yearmon, y = mon_avg, color = Depth), size = 2, position = position_dodge(0.15)) +
geom_line(aes(x = yearmon, y = mon_avg, color = Depth)) +
labs(title = "Average Monthly Dissolved Oxygen",
subtitle = paste0(mon_avg_graph$MLocID[1], ": ",mon_avg_graph$StationDes[1] ),
caption = paste0("Lat/Long: ",
mon_avg_graph$Lat_DD[1], ", ",mon_avg_graph$Long_DD[1] ),
x = element_blank(),
y = "mg/L")+
theme_bw()
#graph no trend values
if(mon_avg_graph_trend$significance[1] == "No Trend"){
p = p + annotate("text", label = "No Trend",
x = as.Date('2020-06-01'),
y = 1.75,
colour = "black", size = 3.5)
} #end of no trend if statement
if(mon_avg_graph_trend$significance[1] != "No Trend"){
p = p + annotate("text", label = "Significant Trend (p-value < 0.10)",
x = ymd('2020-06-01'),
y = 1.7,
colour = "black", size = 3.5)
#plot trend line. This is taken from the coho trends process
slope <- kendall_results[kendall_results$MLocID == unique(sdadm_raw_trend$MLocID)[1], "sen.slope"]
x.delta <- as.numeric((max(mon_avg_graph$year) - min(mon_avg_graph$year)))/2
SK.min <- mean(mon_avg_graph$sdadm, na.rm = TRUE) - x.delta*slope
SK.max <- mean(mon_avg_graph$sdadm, na.rm = TRUE) + x.delta*slope
p <- p + geom_segment(aes(x = ymd('2018-01-01'), y = SK.min,
xend =ymd('2021-02-01'), yend = SK.max, linetype = "SeasMannKendall Trend"),
size = 1.05, color = "gray49") +
scale_linetype_manual(values=c("dotted")) +
guides(linetype=guide_legend(title = element_blank(), order = 2))
}
#Add hypoxia lines
water_status <- data.frame(
stringsAsFactors = TRUE,
Status = c("Hypoxic","Hypoxic",
"Severe Hypoxia","Severe Hypoxia","Suboxic",
"Suboxic","Anoxic","Anoxic"),
Date = c("1/1/2018","2/1/2021","1/1/2018",
"2/1/2021","1/1/2018","2/1/2021",
"1/1/2018","2/1/2021"),
Value = c(1.4, 1.4, 0.5, 0.5, 0.1, 0.1, 0, 0)
) %>%
mutate(Date = mdy(Date),
Value = Value*1.4276) #convert to mg/L
water_status$Status <- factor(water_status$Status, levels = c("Hypoxic", "Severe Hypoxia", "Suboxic", "Anoxic"))
p2 <- p +
geom_line(data = water_status,
aes(x = Date, y = Value, linetype = Status)) +
scale_color_brewer(palette="Paired")
p2
Due to the regular drops into Severe Hypoxia conditions and occasional drops into Suboxic conditions, combined with the lack of a clear downward trend, the data supports this marine assessment unit remaining as category 3B- insufficient data; potential concern.
Newport Line Data
The second data set we analyzed is ship based discrete DO samples taken along the Newport line. We loaded all the Oregon Territorial Waters (3 miles out) data we could find into AWQMS.
newport_line_awqms <- AWQMS_Data(org = "NOAANEWPORTLINE_(NOSTORETID)",
char = "Dissolved oxygen (DO)")